home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / RTBIS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  859b  |  34 lines
  1. FUNCTION rtbis(x1,x2,xacc: real): real;
  2. (* Programs using routine RTBIS must externally define a function
  3. fx(x:real):real which is to be analyzed for roots. *)
  4. LABEL 99;
  5. CONST
  6.    jmax=40;
  7. VAR
  8.    dx,f,fmid,xmid,rtb: real;
  9.    j: integer;
  10. BEGIN
  11.    fmid := fx(x2);
  12.    f := fx(x1);
  13.    IF ((f*fmid) >= 0.0) THEN BEGIN
  14.       writeln('pause in RTBIS');
  15.       writeln('Root must be bracketed for bisection.'); readln
  16.    END;
  17.    IF (f < 0.0) THEN BEGIN
  18.       rtb := x1;
  19.       dx := x2-x1
  20.    END ELSE BEGIN
  21.       rtb := x2;
  22.       dx := x1-x2
  23.    END;
  24.    FOR j := 1 TO jmax DO BEGIN
  25.       dx := dx*0.5;
  26.       xmid := rtb+dx;
  27.       fmid := fx(xmid);
  28.       IF (fmid <= 0.0) THEN rtb := xmid;
  29.       IF ((abs(dx) < xacc) OR (fmid = 0.0)) THEN GOTO 99
  30.    END;
  31.    writeln('pause in RTBIS - too many bisections'); readln;
  32. 99:   rtbis := rtb
  33. END;
  34.